home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / XSOURCE / XSOURCE.ZIP / vfpsource / Browser / runcode.PRG < prev    next >
Encoding:
Text File  |  1998-05-01  |  9.6 KB  |  369 lines
  1. * RunCode.PRG - Run code block interpreter.
  2. *
  3. * Copyright (c) 1998 Microsoft Corp.
  4. * 1 Microsoft Way
  5. * Redmond, WA 98052
  6. *
  7. * Description:
  8. * Runs a block of VFP code via macros without compilation.
  9. *
  10. * Parameter list:
  11. * cCode:    Code to execute or file name that contains code to execute
  12. * lFile:    Specifies source file mode.
  13. *                .F./Empty = Code is specified by cCode.
  14. *                .T. = Code is imported from specified file via cCode value.
  15. * lIgnoreErrors:    Specifies error handling mode.
  16. *                .F./Empty = Errors are trapped and displayed in a wait window.
  17. *                .T. = All errors are ignored.
  18.  
  19.  
  20. LPARAMETERS __tcCode,__tlFile,__tvIgnoreErrors
  21. LOCAL __lcCode,__lcOnError,__llArrayCode,__lcLine,__lnLine,__lcLine2
  22. LOCAL __lcCommand,__lcExpr,__lcChar,__lnAtPos,__lnAtPos2,__lnOccurrence
  23. LOCAL __lnLineTotal,__llTextMode,__lcLastOnError,__lvResult
  24. LOCAL __lcDoExpr,__lnDoLine,__lnDoLineTotal,__lnDoStackCount
  25. LOCAL __lcForExpr,__lnForMax,__lnForStep,__lnForLine,__lnForLineTotal,__lnForStackCount
  26. LOCAL __lcIfExpr,__llIfExpr,__lnIfLine,__lnIfLineTotal,__lnIfStackCount
  27. LOCAL __laLines[1],__laForLines[1],__laIfLines[1],__laDoLines[1]
  28. EXTERNAL ARRAY __tcCode,__laLines,__laForLines,__laIfLines,__laDoLines
  29.  
  30. #DEFINE TAB        CHR(9)
  31. #DEFINE LF        CHR(10)
  32. #DEFINE CR        CHR(13)
  33. #DEFINE CR_LF    CR+LF
  34.  
  35. IF VARTYPE(__tvIgnoreErrors)=="C"
  36.     __lcOnError=ALLTRIM(__tvIgnoreErrors)
  37. ELSE
  38.     __lcOnError=IIF(__tvIgnoreErrors,"=.F.","__")
  39. ENDIF
  40. __llArrayCode=(TYPE("__tcCode[1]")=="C")
  41. IF __llArrayCode
  42.     __lnLineTotal=ACOPY(__tcCode,__laLines)
  43. ELSE
  44.     IF VARTYPE(__tcCode)#"C" OR EMPTY(__tcCode)
  45.         RETURN
  46.     ENDIF
  47.     IF __tlFile
  48.         __lcCode=ALLTRIM(FILETOSTR(__tcCode))
  49.     ELSE
  50.         __lcCode=ALLTRIM(__tcCode)
  51.     ENDIF
  52.     IF LEFT(__lcCode,1)==";"
  53.         __lcCode=STRTRAN(__lcCode,";",CR_LF)
  54.     ENDIF
  55.     __lnLineTotal=ALINES(__laLines,__lcCode)
  56.     IF __lnLineTotal=0
  57.         RETURN
  58.     ENDIF
  59.     PRIVATE __lcLastLine
  60.     __lcLastLine=""
  61.     __lnLine=0
  62.     DO WHILE __lnLine<__lnLineTotal
  63.         __lnLine=__lnLine+1
  64.         __lcLine=ALLTRIM(__laLines[__lnLine])
  65.         __lnAtPos=AT("&"+"&",__lcLine)
  66.         IF __lnAtPos>0
  67.             __lcLine=ALLTRIM(LEFT(__lcLine,__lnAtPos-1))
  68.         ENDIF
  69.         DO WHILE .T.
  70.             __lcChar=LEFT(__lcLine,1)
  71.             IF __lcChar==" " OR __lcChar==TAB
  72.                 __lcLine=ALLTRIM(SUBSTR(__lcLine,2))
  73.                 LOOP
  74.             ENDIF
  75.             __lcChar=RIGHT(__lcLine,1)
  76.             IF __lcChar==" " OR __lcChar==TAB
  77.                 __lcLine=TRIM(LEFT(__lcLine,LEN(__lcLine)-1))
  78.                 LOOP
  79.             ENDIF
  80.             EXIT
  81.         ENDDO
  82.         IF EMPTY(__lcLine) OR LEFT(__lcLine,1)=="*" OR LEFT(__lcLine,1)=="#" OR ;
  83.                 LEFT(__lcLine,2)==("&"+"&") OR UPPER(LEFT(__lcLine,4))=="NOTE" OR ;
  84.                 LEFT(__lcLine,4)=="<!--"
  85.             ADEL(__laLines,__lnLine)
  86.             __lnLineTotal=__lnLineTotal-1
  87.             DIMENSION __laLines[__lnLineTotal]
  88.             __lnLine=__lnLine-1
  89.             LOOP
  90.         ENDIF
  91.         IF __lnLine>=2 AND RIGHT(__laLines[__lnLine-1],1)==";"
  92.             __lcLine2=LEFT(__laLines[__lnLine-1],LEN(__laLines[__lnLine-1])-1)
  93.             DO WHILE .T.
  94.                 __lcChar=RIGHT(__lcLine2,1)
  95.                 IF __lcChar==" " OR __lcChar==TAB
  96.                     __lcLine2=TRIM(LEFT(__lcLine2,LEN(__lcLine2)-1))
  97.                     LOOP
  98.                 ENDIF
  99.                 EXIT
  100.             ENDDO
  101.             __lnLine=__lnLine-1
  102.             __lcLine=__lcLine2+" "+__lcLine
  103.             ADEL(__laLines,__lnLine)
  104.             __lnLineTotal=__lnLineTotal-1
  105.             DIMENSION __laLines[__lnLineTotal]
  106.             __laLines[__lnLine]=__lcLine
  107.         ELSE
  108.             __laLines[__lnLine]=__lcLine
  109.         ENDIF
  110.     ENDDO
  111. ENDIF
  112. IF __lnLineTotal=0
  113.     RETURN
  114. ENDIF
  115. __lcLastOnError=ON("ERROR")
  116. DO CASE
  117.     CASE __lcOnError=="__"
  118.         ON ERROR __RunCodeError(ERROR(),0,"RunCode",__lcLastLine,MESSAGE())
  119.     CASE __lcOnError=="=.F."
  120.         ON ERROR =.F.
  121.     CASE EMPTY(__lcOnError)
  122.         ON ERROR
  123.     OTHERWISE
  124.         ON ERROR &__lcOnError
  125. ENDCASE
  126. __lvResult=.T.
  127. __lcLine=""
  128. STORE .F. TO __llIfExpr,__llTextMode
  129. STORE "" TO __lcDoExpr,__lcForExpr,__lcIfExpr
  130. STORE 0 TO __lnLine,__lnDoLine,__lnDoLineTotal,__lnDoStackCount, ;
  131.         __lnForLine,__lnForLineTotal,__lnForStackCount,__lnForMax, ;
  132.         __lnForStep,__lnIfLine,__lnIfLineTotal,__lnIfStackCount
  133. DO WHILE __lnLine<__lnLineTotal
  134.     __lnLine=__lnLine+1
  135.     __lcLine=__laLines[__lnLine]
  136.     IF EMPTY(__lcLine)
  137.         LOOP
  138.     ENDIF
  139.     IF LEFT(__lcLine,1)=="="
  140.         EVALUATE(SUBSTR(__lcLine,2))
  141.         LOOP
  142.     ENDIF
  143.     __lcCommand=UPPER(LEFT(__lcLine,4))
  144.     IF __lcCommand=="DO W" AND (UPPER(LEFT(__lcLine,8))=="DO WHIL " OR ;
  145.             UPPER(LEFT(__lcLine,8))=="DO WHILE")
  146.         __lcCommand="DO_W"
  147.         __lnOccurrence=2
  148.     ELSE
  149.         __lnOccurrence=1
  150.     ENDIF
  151.     __lnAtPos=AT(" ",__lcCommand,__lnOccurrence)
  152.     __lnAtPos2=AT(TAB,__lcCommand,__lnOccurrence)
  153.     IF BETWEEN(__lnAtPos2,1,__lnAtPos)
  154.         __lnAtPos=__lnAtPos2
  155.     ENDIF
  156.     IF __lnAtPos>0
  157.         __lcCommand=LEFT(__lcCommand,__lnAtPos-1)
  158.     ENDIF
  159.     __lnAtPos=AT(" ",__lcLine,__lnOccurrence)
  160.     __lnAtPos2=AT(TAB,__lcLine,__lnOccurrence)
  161.     IF BETWEEN(__lnAtPos2,1,__lnAtPos)
  162.         __lnAtPos=__lnAtPos2
  163.     ENDIF
  164.     IF __lnAtPos=0
  165.         __lcExpr=""
  166.     ELSE
  167.         __lcExpr=ALLTRIM(SUBSTR(__lcLine,__lnAtPos+1))
  168.     ENDIF
  169.     __lcLastLine=__lcLine
  170.     DO CASE
  171.         CASE __lcCommand=="EXIT"
  172.             IF __llArrayCode
  173.                 RETURN .F.
  174.             ENDIF
  175.             LOOP
  176.         CASE __lcCommand=="ENDT"
  177.             __llTextMode=.F.
  178.             LOOP
  179.         CASE __llTextMode
  180.             __lcLine="\"+__lcLine
  181.             __lcLastLine=__lcLine
  182.             &__lcLine
  183.             LOOP
  184.         CASE __lcCommand=="DO_W"
  185.             __lnDoStackCount=__lnDoStackCount+1
  186.             IF __lnDoStackCount=1 AND __lnForStackCount=0 AND __lnIfStackCount=0
  187.                 __lcDoExpr=__lcExpr
  188.                 __lnDoLine=__lnLine
  189.                 LOOP
  190.             ENDIF
  191.         CASE __lcCommand=="FOR"
  192.             __lnForStackCount=__lnForStackCount+1
  193.             IF __lnDoStackCount=0 AND __lnDoStackCount=0 AND __lnIfStackCount=0
  194.                 __lnAtPos=ATC(" TO ",__lcExpr)
  195.                 IF __lnAtPos=0
  196.                     __lcForExpr=""
  197.                     __lnForMax=0
  198.                     __lnForStep=0
  199.                     LOOP
  200.                 ENDIF
  201.                 __lcForExpr=__lcExpr
  202.                 __lcForExpr=ALLTRIM(LEFT(__lcExpr,__lnAtPos-1))
  203.                 __lcExpr=ALLTRIM(SUBSTR(__lcExpr,__lnAtPos+4))
  204.                 __lnAtPos=ATC("=",__lcForExpr)
  205.                 IF __lnAtPos=0
  206.                     LOOP
  207.                 ENDIF
  208.                 &__lcForExpr
  209.                 __lcForExpr=ALLTRIM(LEFT(__lcForExpr,__lnAtPos-1))
  210.                 __lnAtPos=ATC(" STEP ",__lcExpr)
  211.                 IF __lnAtPos=0
  212.                     __lnForMax=EVALUATE(__lcExpr)
  213.                     __lnForStep=1
  214.                 ELSE
  215.                     __lnForMax=EVALUATE(LEFT(__lcExpr,__lnAtPos-1))
  216.                     __lnForStep=EVALUATE(SUBSTR(__lcExpr,__lnAtPos+6))
  217.                 ENDIF
  218.                 __lnForLine=__lnLine
  219.                 LOOP
  220.             ENDIF
  221.         CASE __lcCommand=="IF"
  222.             __lnIfStackCount=__lnIfStackCount+1
  223.             IF __lnIfStackCount=1 AND __lnDoStackCount=0 AND __lnForStackCount=0
  224.                 __lcIfExpr=__lcExpr
  225.                 __llIfExpr=EVALUATE(__lcIfExpr)
  226.                 __lnIfLine=__lnLine
  227.                 LOOP
  228.             ENDIF
  229.         CASE __lcCommand=="ELSE"
  230.             IF __lnIfStackCount=1 AND __lnDoStackCount=0 AND __lnForStackCount=0
  231.                 __llIfExpr=(NOT __llIfExpr)
  232.                 LOOP
  233.             ENDIF
  234.         CASE __lcCommand=="ENDD"
  235.             __lnDoStackCount=__lnDoStackCount-1
  236.             IF __lnDoStackCount=0 AND __lnForStackCount=0 AND __lnIfStackCount=0
  237.                 DO WHILE NOT EMPTY(__lcDoExpr) AND EVALUATE(__lcDoExpr)
  238.                     __lvResult=RunCode(@__laDoLines,.F.,__tvIgnoreErrors)
  239.                     IF ISNULL(__laDoLines[1])
  240.                         IF __llArrayCode
  241.                             __tcCode[1]=.NULL.
  242.                         ENDIF
  243.                         RETURN __lvResult
  244.                     ENDIF
  245.                     IF NOT __lvResult
  246.                         EXIT
  247.                     ENDIF
  248.                 ENDDO
  249.                 __lcDoExpr=""
  250.                 __llDoExpr=.F.
  251.                 __lnDoLine=0
  252.                 DIMENSION __laDoLines[1]
  253.                 __laDoLines=.F.
  254.                 __lnDoLineTotal=0
  255.                 LOOP
  256.             ENDIF
  257.         CASE __lcCommand=="ENDF"
  258.             __lnForStackCount=__lnForStackCount-1
  259.             IF __lnDoStackCount=0 AND __lnForStackCount=0 AND __lnIfStackCount=0
  260.                 DO WHILE EVALUATE(__lcForExpr)<=__lnForMax
  261.                     __lvResult=RunCode(@__laForLines,.F.,__tvIgnoreErrors)
  262.                     IF ISNULL(__laForLines[1])
  263.                         IF __llArrayCode
  264.                             __tcCode[1]=.NULL.
  265.                         ENDIF
  266.                         RETURN __lvResult
  267.                     ENDIF
  268.                     IF NOT __lvResult
  269.                         EXIT
  270.                     ENDIF
  271.                     __lcExpr=__lcForExpr+"="+__lcForExpr+"+"+TRANSFORM(__lnForStep)
  272.                     &__lcExpr
  273.                 ENDDO
  274.                 __lcForExpr=""
  275.                 __lnForCount=0
  276.                 __lnForMax=0
  277.                 __lnForStep=0
  278.                 __lnForLine=0
  279.                 DIMENSION __laForLines[1]
  280.                 __laForLines=.F.
  281.                 __lnForLineTotal=0
  282.                 LOOP
  283.             ENDIF
  284.         CASE __lcCommand=="ENDI"
  285.             __lnIfStackCount=__lnIfStackCount-1
  286.             IF __lnIfStackCount=0 AND __lnDoStackCount=0 AND __lnForStackCount=0
  287.                 __lvResult=RunCode(@__laIfLines,.F.,__tvIgnoreErrors)
  288.                 IF ISNULL(__laIfLines[1])
  289.                     IF __llArrayCode
  290.                         __tcCode[1]=.NULL.
  291.                     ENDIF
  292.                     RETURN __lvResult
  293.                 ENDIF
  294.                 __lcIfExpr=""
  295.                 __llIfExpr=.F.
  296.                 __lnIfLine=0
  297.                 DIMENSION __laIfLines[1]
  298.                 __laIfLines=.F.
  299.                 __lnIfLineTotal=0
  300.                 LOOP
  301.             ENDIF
  302.     ENDCASE
  303.     IF __lnDoStackCount>0
  304.         __lnDoLineTotal=__lnDoLineTotal+1
  305.         DIMENSION __laDoLines[__lnDoLineTotal]
  306.         __laDoLines[__lnDoLineTotal]=__lcLine
  307.         LOOP
  308.     ENDIF
  309.     IF __lnForStackCount>0 AND __lnDoStackCount=0
  310.         __lnForLineTotal=__lnForLineTotal+1
  311.         DIMENSION __laForLines[__lnForLineTotal]
  312.         __laForLines[__lnForLineTotal]=__lcLine
  313.         LOOP
  314.     ENDIF
  315.     IF __lnIfStackCount>0
  316.         IF NOT __llIfExpr
  317.             LOOP
  318.         ENDIF
  319.         __lnIfLineTotal=__lnIfLineTotal+1
  320.         DIMENSION __laIfLines[__lnIfLineTotal]
  321.         __laIfLines[__lnIfLineTotal]=__lcLine
  322.         LOOP
  323.     ENDIF
  324.     DO CASE
  325.         CASE __lcCommand=="RETU"
  326.             IF __llArrayCode
  327.                 __tcCode[1]=.NULL.
  328.             ENDIF
  329.             IF NOT EMPTY(__lcExpr)
  330.                 __lvResult=EVALUATE(__lcExpr)
  331.             ENDIF
  332.             EXIT
  333.         CASE __lcCommand=="TEXT"
  334.             __llTextMode=.T.
  335.             LOOP
  336.         CASE __lcCommand=="ENDT"
  337.             __llTextMode=.F.
  338.             LOOP
  339.     ENDCASE
  340.     &__lcLine
  341. ENDDO
  342. IF EMPTY(__lcLastOnError)
  343.     ON ERROR
  344. ELSE
  345.     ON ERROR &__lcLastOnError
  346. ENDIF
  347. RETURN __lvResult
  348.  
  349.  
  350.  
  351. FUNCTION __RunCodeError(tnError,tnLine,tcMethod,tcLine,tcMessage)
  352. LOCAL lcMessage
  353.  
  354. lcMessage="RunCode Runtime Error"+CR_LF+ ;
  355.         REPLICATE("-",40)+CR_LF+ ;
  356.         "Error:      "+TRANSFORM(tnError)+CR_LF+ ;
  357.         TRANSFORM(tcMessage)+CR_LF+ ;
  358.         REPLICATE("-",40)+CR_LF+ ;
  359.         "Method:  "+TRANSFORM(tcMethod)+CR_LF+ ;
  360.         "Line        "+TRANSFORM(tnLine)+CR_LF+ ;
  361.         REPLICATE("-",40)+CR_LF+ ;
  362.         TRANSFORM(tcLine)
  363. WAIT CLEAR
  364. WAIT WINDOW LEFT(lcMessage,254) NOWAIT
  365. ENDFUNC
  366.  
  367.  
  368. *-- end RunCode.PRG
  369.